Option Strict Off
Option Explicit On

Namespace SDIFChecker
    Public Module SDIF

        Public Const SDIF_WARNING As Short = 8
        Public Const SDIF_CRITICAL As Short = 12
        Public Const SDIF_INFORMATIONAL As Short = 4

        Public giError As Short

        Public gsSDIFField As String
        Public gsSDIFRec As String
        Public giSDIFStart As Short
        Public giSDIFLength As Short
        Public giSDIFRec As Short
        Public giSDIFRecMax As Short

        Public gsType(20) As String ' A0, C1 ...
        Public gsTypePresent(20) As Boolean
        Public giTypeNo(20) As Short ' size of A0, C1 ...
        Public gsFType(20, 50) As String ' Integer or Text
        Public giStart(20, 50) As Short ' Start
        Public giLength(20, 50) As Short ' Length
        Public gsAttribute(20, 50) As String ' Database attribute name
        Public gsMandatory(20, 50) As String ' m1 or m2
        Public gsVariable(20, 50) As String ' variable

        Dim gsCCard, gsCCard2 As String
        Dim giCStart As Short
        Dim giCLength As Short
        Dim gsCMandatory As String
        Dim gsCType As String
        Dim gsCVariable As String

        Dim tiCount As Short
        Public Const gnSCREEN As Short = 0 'used to center forms on screen
        Public Const gnMDIFORM As Short = 1 'used to center forms on frmMDI

        Dim SkipType() As String
        Dim tiSkipN As Short


        Function LoadSDIFDDL(ByRef tFile As String) As Short
            Dim Y, I, X, Z As Short
            Dim tStr As String = ""
            Dim FileNumber As Short

            FileNumber = FreeFile()
            I = 0
            X = 0
            Y = 0
            Z = -1

            Try
                FileOpen(FileNumber, tFile, OpenMode.Input)
                Z = 0
                Do While Not EOF(FileNumber)
                    tStr = LineInput(FileNumber)
                    Z = Z + 1
                    If Left(tStr, 1) = ";" Or Left(tStr, 1) = "#" Or Len(tStr) = 0 Then
                        ' comment line
                    Else
                        gsCCard = CStr(GetField(0, tStr))
                        If gsCCard <> gsCCard2 Then
                            If Y <> 0 Then
                                I = I + 1
                                X = 0
                            End If
                            gsCCard2 = gsCCard
                            gsType(I) = gsCCard
                            Y = 1
                        End If
                        giCStart = CShort(GetField(1, tStr))
                        giCLength = CShort(GetField(2, tStr))
                        giStart(I, X) = giCStart
                        giLength(I, X) = giCLength
                        gsCMandatory = CStr(GetField(3, tStr))
                        gsMandatory(I, X) = gsCMandatory
                        gsCType = CStr(GetField(4, tStr))
                        gsFType(I, X) = gsCType
                        gsCVariable = CStr(GetField(5, tStr))
                        gsVariable(I, X) = gsCVariable
                        gsAttribute(I, X) = CStr(GetField(6, tStr))
                        X = X + 1
                        giTypeNo(I) = X
                    End If
                Loop
            Catch ex As Exception
                LoadSDIFDDL = Z
                SDIFChecker.gsString = tStr
            Finally
                ' Close before reopening in another mode.
                FileClose(FileNumber)
            End Try

            LoadSDIFDDL = 0
            Exit Function

        End Function

        Function CSngTime(ByRef tStr As String) As Single
            Dim I As Short

            For I = 1 To Len(tStr)
                If InStr(1, " 0123456789:.", Mid(tStr, I, 1), CompareMethod.Binary) = 0 Then
                    CSngTime = -1
                    Exit Function
                End If
            Next I

            If CountCharString(tStr, ":") > 1 Then
                CSngTime = -1
                Exit Function
            End If

            If CountCharString(tStr, ".") > 1 Then
                CSngTime = -1
                Exit Function
            End If

            Try
                If InStr(1, tStr, ":") <> 0 Then
                    CSngTime = CSng(Left(tStr, InStr(1, tStr, ":") - 1)) * 100
                    CSngTime = CSngTime + CSng(Right(tStr, Len(tStr) - InStr(1, tStr, ":") - 1))
                Else
                    CSngTime = CSng(tStr)
                End If
            Catch ex As Exception
                CSngTime = -1
            End Try
        End Function

        Function CountCharString(ByRef tField As String, ByVal tChar As Char) As Integer
            Dim strArr() As String

            Try
                strArr = tField.Split(tChar)
                Return strArr.Length - 1
            Catch ex As Exception
                Return 0
            End Try

        End Function

        Function GetSDIFField(ByRef tField As String, ByRef tType As String, ByRef tStr As String) As Object
            Dim X, Y As Short
            Dim tTmp As String

            gsSDIFField = tField 'Potential debugging information
            gsSDIFRec = tStr
            giSDIFStart = 0
            giSDIFLength = 0
            On Error Resume Next
            For X = 0 To UBound(gsType) - 1
                If UCase(gsType(X)) = UCase(tType) Then
                    For Y = 0 To giTypeNo(X) - 1
                        If UCase(tField) = UCase(gsAttribute(X, Y)) Then
                            GetSDIFField = Y + 1
                            giSDIFStart = giStart(X, Y)
                            giSDIFLength = giLength(X, Y)
                            tTmp = RTrim(Mid(tStr, giSDIFStart, giSDIFLength))
                            If gsFType(X, Y) = "INT" Then
                                If IsNothing(tTmp) Then
                                    GetSDIFField = 0
                                Else
                                    GetSDIFField = CShort(tTmp)
                                End If
                            Else
                                GetSDIFField = RTrim(tTmp)
                            End If
                            Exit Function
                        End If
                    Next Y
                    MsgBox("GetSDIFField Error: """ & tField & """ (" & tType & ") not found in SDIF conversion template!", MsgBoxStyle.Critical)
                    'Debug.Print tField & " " & tType & " - not found"
                    GetSDIFField = ""
                    Exit Function
                End If
            Next X
            MsgBox("GetSDIFField Error: """ & tType & """ record not found in SDIF conversion template!", MsgBoxStyle.Critical)
            GetSDIFField = ""
        End Function

        Function GetLast(ByRef tStr As String) As String
            On Error Resume Next
            If InStr(1, tStr, ",") Then
                GetLast = Left(tStr, InStr(1, tStr, ",") - 1)
            Else
                GetLast = RTrim(tStr)
            End If

        End Function

        Function GetFirst(ByRef tStr As String) As String
            On Error Resume Next
            If InStr(1, tStr, ",") Then
                GetFirst = RTrim(Right(tStr, Len(tStr) - InStr(1, tStr, ",") - 1))
                If GetMI(tStr) <> "" Then
                    GetFirst = Left(GetFirst, Len(GetFirst) - 2)
                End If
            Else
                GetFirst = RTrim(tStr)
            End If

        End Function

        Function GetMI(ByRef tStr As String) As String
            Dim I As Short
            Dim sTmp As String
            On Error Resume Next
            GetMI = ""
            If InStr(1, tStr, ",") Then
                sTmp = Right(tStr, Len(tStr) - InStr(1, tStr, ",") - 1)
                I = Len(sTmp)
                If Mid(sTmp, I - 1, 1) = " " Then
                    GetMI = Mid(sTmp, I, 1)
                End If
            End If
        End Function

        Function GetField(ByRef I As Short, ByRef tStr As String) As String

            If I = 0 Then
                If Left(tStr, 1) = Chr(34) Then
                    GetField = Mid(tStr, 2, InStr(2, tStr, Chr(34)) - 2)
                Else
                    If InStr(1, tStr, ",") Then
                        GetField = Left(tStr, InStr(I + 1, tStr, ",") - 1)
                    Else
                        GetField = tStr
                    End If
                End If
            Else
                GetField = Debuf(I, tStr)
            End If


        End Function

        Function Debuf(ByRef I As Short, ByRef tStr As String) As String
            Dim X As Short
            Dim iQCnt As Short
            Dim bQuote As Boolean
            Dim bSwt As Boolean
            Dim tChar As String

            bSwt = False
            bQuote = False
            iQCnt = 0
            Debuf = ""

            Try
                For X = 1 To Len(tStr)
                    tChar = Mid(tStr, X, 1)
                    Select Case tChar
                        Case Chr(34)
                            If bQuote = True Then
                                bQuote = False
                            Else
                                bQuote = True
                            End If
                        Case ","
                            If bQuote = False Then
                                bSwt = True
                                iQCnt = iQCnt + 1
                            End If
                        Case Else
                            If bSwt = True And iQCnt = I Then
                                If bQuote = True Then
                                    Debuf = Mid(tStr, X, InStr(X, tStr, Chr(34)) - X)
                                Else
                                    If InStr(X, tStr, ",") Then
                                        Debuf = Mid(tStr, X, InStr(X, tStr, ",") - X)
                                    Else
                                        Debuf = Right(tStr, Len(tStr) - X + 1)
                                    End If
                                End If
                                Exit Function
                            End If
                    End Select
                Next X
            Catch ex As Exception
                Debuf = ""
            End Try

        End Function
    End Module
End Namespace